home *** CD-ROM | disk | FTP | other *** search
/ PC World 2006 November / PCWorld_2006-11_cd.bin / domacnost a kancelar / findgraph / fgraph.exe / {app} / TestVB / Form1.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2005-10-13  |  10.8 KB  |  353 lines
  1. VERSION 5.00
  2. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  3. Begin VB.Form Form1 
  4.    Caption         =   "FindGraph automation, sample 1"
  5.    ClientHeight    =   4140
  6.    ClientLeft      =   7365
  7.    ClientTop       =   345
  8.    ClientWidth     =   4980
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   4140
  11.    ScaleWidth      =   4980
  12.    Begin VB.CommandButton Digitize 
  13.       Caption         =   "Digitize"
  14.       Height          =   516
  15.       Left            =   3360
  16.       Picture         =   "Form1.frx":0000
  17.       Style           =   1  'Graphical
  18.       TabIndex        =   5
  19.       ToolTipText     =   "Add picture and  digitize blue line"
  20.       Top             =   3480
  21.       Width           =   1452
  22.    End
  23.    Begin VB.CommandButton TestAddOne 
  24.       Caption         =   "Add One"
  25.       Height          =   516
  26.       Left            =   3360
  27.       Picture         =   "Form1.frx":0312
  28.       Style           =   1  'Graphical
  29.       TabIndex        =   2
  30.       ToolTipText     =   "Add 20 points on one"
  31.       Top             =   1318
  32.       Width           =   1452
  33.    End
  34.    Begin MSComctlLib.ListView ListView1 
  35.       Height          =   3375
  36.       Left            =   120
  37.       TabIndex        =   6
  38.       Top             =   600
  39.       Width           =   3135
  40.       _ExtentX        =   5530
  41.       _ExtentY        =   5953
  42.       View            =   3
  43.       LabelWrap       =   -1  'True
  44.       HideSelection   =   -1  'True
  45.       _Version        =   393217
  46.       ForeColor       =   -2147483640
  47.       BackColor       =   -2147483643
  48.       BorderStyle     =   1
  49.       Appearance      =   1
  50.       NumItems        =   0
  51.    End
  52.    Begin VB.CheckBox CheckVisible 
  53.       Caption         =   "Visible FindGraph"
  54.       Height          =   195
  55.       Left            =   3360
  56.       TabIndex        =   0
  57.       ToolTipText     =   "Show/Hide FindGraph"
  58.       Top             =   240
  59.       Value           =   1  'Checked
  60.       Width           =   1572
  61.    End
  62.    Begin VB.CommandButton TestProp 
  63.       Caption         =   "Properties"
  64.       Height          =   516
  65.       Left            =   3360
  66.       Picture         =   "Form1.frx":0624
  67.       Style           =   1  'Graphical
  68.       TabIndex        =   4
  69.       ToolTipText     =   "Change plot tile and scales"
  70.       Top             =   2760
  71.       Width           =   1452
  72.    End
  73.    Begin VB.CommandButton TestGet 
  74.       Caption         =   "Get"
  75.       Height          =   516
  76.       Left            =   3360
  77.       Picture         =   "Form1.frx":0936
  78.       Style           =   1  'Graphical
  79.       TabIndex        =   3
  80.       ToolTipText     =   "Create new area and get all points selected"
  81.       Top             =   2040
  82.       Width           =   1452
  83.    End
  84.    Begin VB.CommandButton TestAddArray 
  85.       Caption         =   "Add Array"
  86.       Height          =   516
  87.       Left            =   3360
  88.       Picture         =   "Form1.frx":0C48
  89.       Style           =   1  'Graphical
  90.       TabIndex        =   1
  91.       ToolTipText     =   "Add 500 points at once"
  92.       Top             =   600
  93.       Width           =   1452
  94.    End
  95. Attribute VB_Name = "Form1"
  96. Attribute VB_GlobalNameSpace = False
  97. Attribute VB_Creatable = False
  98. Attribute VB_PredeclaredId = True
  99. Attribute VB_Exposed = False
  100. Private Declare Function GetModuleFileName Lib "kernel32" _
  101.          Alias "GetModuleFileNameA" _
  102.          (ByVal hModule As Long, _
  103.          ByVal lpFileName As String, _
  104.          ByVal nSize As Long) As Long
  105. Dim FindGraph As Object
  106. Sub LogError()
  107.     Print "error " & Err.Description
  108. End Sub
  109. Private Sub Form_Load()
  110.     On Error GoTo ErrHandler
  111.     ' Create object FindGraph
  112.     Set FindGraph = CreateObject("FindGraph.Document")
  113.     ' Run program FindGraph in new window
  114.     FindGraph.AppInit (1)
  115.     Exit Sub
  116. ErrHandler:
  117.     LogError
  118.     Exit Sub
  119. End Sub
  120. Private Sub Form_Unload(Cancel As Integer)
  121.     On Error GoTo ErrHandler
  122.     ' Close FindGraph application
  123.     FindGraph.AppQuit
  124. ErrHandler:
  125.     Set FindGraph = Nothing
  126. End Sub
  127. ' The example how to hide/show FindGraph main window
  128. Private Sub CheckVisible_Click()
  129.     FindGraph.Visible = CheckVisible.Value 'True
  130. End Sub
  131. ' The example how to add series of points
  132. ' Create new series named "VB_series"
  133. ' Add 500 points at once
  134. Private Sub TestAddArray_Click()
  135.     On Error GoTo ErrHandler
  136.     Dim dwId, it, N As Long
  137.     Dim fX, fY, fZ As Double
  138.     N = 500
  139.     Dim va(1500) As Variant ' dimension N*3
  140.      
  141.     ' Create new series of points
  142.     dwId = FindGraph.DotsNew(2, 2, 20, 1, "VB_series")
  143.     ' Set the identifier of a series
  144.     FindGraph.ArrayId = dwId
  145.     ' Fill array with points
  146.     For i = 1 To N
  147.         fX = CDbl(8# / N * i)
  148.         fY = CDbl(5# / N * i)
  149.         fZ = CDbl(i)
  150.         it = (i - 1) * 3
  151.         va(it) = fX
  152.         va(it + 1) = fY
  153.         va(it + 2) = fZ
  154.     Next i
  155.     ' Add all array at once
  156.     FindGraph.ArrayVar = va
  157.     ' Repaint points
  158.     FindGraph.DotsUpdate dwId
  159.     Exit Sub
  160. ErrHandler:
  161.     LogError
  162.     Exit Sub
  163. End Sub
  164. ' The example how to add one point to series
  165. ' Create new series named "VB_point"
  166. ' Add 20 points on one
  167. Private Sub TestAddOne_Click()
  168.     On Error GoTo ErrHandler
  169.     Dim dwId, it, N As Long
  170.     Dim fX, fY, fZ As Double
  171.     N = 20
  172.     ' Create new series of points
  173.     dwId = FindGraph.DotsNew(1, 1, 50, 1, "VB_point")
  174.     For i = 1 To N
  175.         fX = CDbl(0.3 * i)
  176.         fY = CDbl(0.4 * i)
  177.         ' Add single point to series
  178.         FindGraph.DotsAddPoint dwId, fX, fY, 0
  179.         ' Repaint points
  180.         FindGraph.DotsUpdate dwId
  181.     Next i
  182.     FindGraph.DotsUpdate dwId
  183.     Exit Sub
  184. ErrHandler:
  185.     LogError
  186.     Exit Sub
  187. End Sub
  188. ' Create and select new area named "clip"
  189. ' Use nodes from VARIANT var array
  190. Private Sub NewClip()
  191.     Dim dwId As Long
  192.     On Error GoTo ErrHandler
  193.     dwId = FindGraph.ClipNewEmptyRgn(1) ' BLUE
  194.     FindGraph.ArrayId = dwId
  195.     ' Nodes (X,Y)
  196.     Dim va(12) As Variant ' dimension 4*3
  197.         va(0) = 1# '(1,5)
  198.         va(1) = 5#
  199.         va(2) = 0#
  200.         va(3) = 5# '(5,8)
  201.         va(4) = 8#
  202.         va(5) = 1#
  203.         va(6) = 7# '(7,5)
  204.         va(7) = 5#
  205.         va(8) = 2#
  206.         va(9) = 5# '(5,1)
  207.         va(10) = 1#
  208.         va(11) = 3#
  209.     ' Create array of nodes
  210.     FindGraph.ArrayVar = va
  211.     ' Select the area
  212.     FindGraph.ClipSelect dwId, 1
  213.     Exit Sub
  214. ErrHandler:
  215.     LogError
  216.     Exit Sub
  217. End Sub
  218. ' The example how to create new area and get all points selected
  219. Private Sub TestGet_Click()
  220.     On Error GoTo ErrHandler
  221.     Dim fX, fY, fZ As Double
  222.     ListInit
  223.     ' Create new area and select it
  224.     NewClip
  225.    ' GoTo ByOne
  226. ByVar:
  227.     ' The example how to get whole array of points immediately
  228.     ' Points - three-tuples (X,Y,Z)
  229.     ' Copy selected points, put it on the buffer.
  230.     ' N number of points selected
  231.     N = FindGraph.SelectedGetStart(0)
  232.     Dim va As Variant
  233.     va = FindGraph.ArrayVar
  234.     NGet = (UBound(va) + 1) / 3
  235.     If N > NGet Then N = NGet
  236.     Print "ub"; UBound(va)
  237.     ' Fill the grid with points (X, Y, Z)
  238.     For i = 1 To N
  239.         it = 3 * (i - 1)
  240.         fX = va(it)
  241.         fY = va(it + 1)
  242.         fZ = va(it + 2)
  243.         ListAdd fX, fY, fZ
  244.     Next i
  245.     ' Free memory
  246.     FindGraph.SelectedGetStop (0)
  247.     Exit Sub
  248.      
  249. ByOne:
  250.     ' The example how to get single point
  251.     ' Points - three-tuples (X,Y,Z)
  252.     ' Copy selected points, put it on the buffer.
  253.     ' N number of points selected
  254.     N = FindGraph.SelectedGetStart(0)
  255.     Print "n"; N
  256.     ' In cycle we choose points and add to grid
  257.     For i = 1 To N
  258.         fX = FindGraph.SelectedGetX(i - 1)
  259.         fY = FindGraph.SelectedGetY(i - 1)
  260.         fZ = FindGraph.SelectedGetZ(i - 1)
  261.         ListAdd fX, fY, fZ
  262.     Next i
  263.     ' Free memory
  264.     FindGraph.SelectedGetStop (0)
  265.     Exit Sub
  266. ErrHandler:
  267.     LogError
  268.     Exit Sub
  269. End Sub
  270. ' The example how to change plot properties
  271. Private Sub TestProp_Click()
  272.     On Error GoTo ErrHandler
  273.     ' Change the title
  274.     FindGraph.DocTitle = "From VB title"
  275.     ' Change the scale of X axe
  276.     FindGraph.AxeXscale = 2
  277.     ' Repaint
  278.     FindGraph.DocUpdate
  279.     Exit Sub
  280. ErrHandler:
  281.     LogError
  282.     Exit Sub
  283. End Sub
  284. ' The example how to digitize the background picture
  285. ' Display the background picture
  286. ' Create rectangle area and select it
  287. ' Digitize blue line inside rectangle
  288. ' Create new series named "FromPict"
  289. ' Assign green color and radius of circle 1 mm to points of series
  290. Private Sub Digitize_Click()
  291.     On Error GoTo ErrHandler
  292.     'Get file name from module path and exe name
  293.     Dim strFileName As String
  294.     Dim lngCount As Long
  295.     strFileName = String(512, 0)
  296.     lngCount = GetModuleFileName(App.hInstance, strFileName, 512)
  297.     strFileName = Left(strFileName, lngCount - 10) & "money.gif"
  298.     ' Change the title
  299.     FindGraph.DocTitle = "Digitize Now"
  300.     ' Set background picture file name
  301.     'FindGraph.DocPictFileName = "d:\vc\FindGraph\TestVB\money.gif"
  302.     FindGraph.DocPictFileName = strFileName
  303.     ' Display background picture
  304.     FindGraph.DocPictIs = True
  305.     ' rectangle in physical units from (1,4) to (10,8)
  306.     ' Get axes scales
  307.     Dim fXStart, fXScale, fYStart, fYScale As Double
  308.     fXStart = FindGraph.AxeXstart
  309.     fXScale = FindGraph.AxeXscale
  310.     fYStart = FindGraph.AxeYstart
  311.     fYScale = FindGraph.AxeYscale
  312.     ' Calculate rectangle
  313.     Dim fLeft, fTop, fRight, fBottom As Double
  314.     fLeft = fXStart + fXScale * 1#
  315.     fTop = fYStart + fYScale * 4#
  316.     fRight = fXStart + fXScale * 10#
  317.     fBottom = fYStart + fYScale * 8#
  318.      ' Create rectangle area with color number = 2 (GREEN)
  319.     Dim dwIdArea As Long
  320.     dwIdArea = FindGraph.ClipNewRect(2, fLeft, fTop, fRight, fBottom)
  321.      ' Select area
  322.     FindGraph.ClipSelect dwIdArea, 1
  323.     ' Digitize points inside rectangle
  324.     ' Color number = 1 (BLUE)
  325.     ' Radius of digitizing = 20 (2.0 mm)
  326.     Dim dwIdDots As Long
  327.     dwIdDots = FindGraph.DotsFromPict(1, 20, "FromPict")
  328.     ' Assign green color, color number = 2 (GREEN)
  329.     FindGraph.DotsColorNumSet dwIdDots, 2
  330.     ' Assign radius of new points = 10 (1.0 mm)
  331.     FindGraph.DotsWidthSet dwIdDots, 10
  332.       
  333.     ' Repaint
  334.     FindGraph.DocUpdate
  335.     Exit Sub
  336. ErrHandler:
  337.     LogError
  338.     Exit Sub
  339. End Sub
  340. Private Sub ListInit()
  341.     ListView1.ListItems.Clear
  342.     Dim Col As ColumnHeader ' Declare variable
  343.     Set Col = ListView1.ColumnHeaders.Add(, , "X", ListView1.Width / 3)
  344.     Set Col = ListView1.ColumnHeaders.Add(, , "Y", ListView1.Width / 3)
  345.     Set Col = ListView1.ColumnHeaders.Add(, , "Z", ListView1.Width / 3)
  346. End Sub
  347. Private Sub ListAdd(X, Y, Z)
  348.     Dim Insert As ListItem
  349.     Set Insert = ListView1.ListItems.Add(, , CStr(X))
  350.     Insert.SubItems(1) = CStr(Y)
  351.     Insert.SubItems(2) = CStr(Z)
  352. End Sub
  353.